home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
TURB_VIS
/
MACROS
/
MACDEMO.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-01-31
|
8KB
|
289 lines
{
Very simple application to demonstrate Macros. Documented to show the
modifications you will need to make to your application to implement
macros.
}
Program MacDemo;
{$DEFINE MACROS} {implement macros}
{$X+}
{------------------------ Macros Modification ----------------------------}
{ Include Macros on your Uses line. (MacHelp is added for this demo). }
{-------------------------------------------------------------------------}
Uses Objects, Drivers, Views, Menus, App, HelpFile, MsgBox
{$IFDEF MACROS}
,Macros,
MacHelp
{$ENDIF}
;
const
cmRecordMacro = 1500;
cmStopRecording = 1501;
cmPlaybackMacro = 1502;
cmDeleteMacro = 1503;
Type
{------------------------ Macros Modification ----------------------------}
{ MyApp is an object of type TMacApp instead of TApplication. }
{-------------------------------------------------------------------------}
PMyApp = ^MyApp;
{$IFDEF MACROS}
MyApp = Object(TMacApp)
{$ELSE}
MyApp = Object(TApplication)
{$ENDIF}
Constructor Init;
Procedure InitStatusLine; Virtual;
Procedure InitMenuBar; Virtual;
Procedure HandleEvent(var Event: TEvent); Virtual;
{$IFDEF MACROS}
Procedure GetEvent(var Event: TEvent); virtual;
{$ENDIF}
function GetPalette: PPalette; virtual;
Procedure NewWindow;
Destructor Done; Virtual;
End;
PMyStatusLine = ^TMyStatusLine;
TMyStatusLine = object(TStatusLine)
function Hint(AHelpCtx: Word): String; virtual;
end;
PMyWindow = ^TMyWindow;
TMyWindow = Object(TWindow)
Constructor Init(Bounds: TRect; WinTitle: String; WindowNo: Word);
End;
PMyDeskTop = ^TMyDeskTop;
TMyDeskTop = object(TDeskTop)
Windw: PMyWindow;
End;
Const
cmNewWin = 101;
function TMyStatusLine.Hint(AHelpCtx: Word): String;
var Mem : string;
begin
str(MemAvail, Mem);
Hint := Mem + ' free';
end;
{ ** MyApp **}
Constructor MyApp.Init;
Begin
{------------------------ Macros Modification ----------------------------}
{ Call TMacApp.Init instead of TApplication.Init }
{-------------------------------------------------------------------------}
{$IFDEF MACROS}
TMacApp.Init;
{$ELSE}
TApplication.Init;
{$ENDIF}
RegisterHelpFile;
End;
Destructor MyApp.Done;
Begin
{------------------------ Macros Modification ----------------------------}
{ Call TMacApp.Done instead of TApplication.Done }
{-------------------------------------------------------------------------}
{$IFDEF MACROS}
TMacApp.Done;
{$ELSE}
TApplication.Done;
{$ENDIF}
End;
function MyApp.GetPalette: PPalette;
const
CNewColor = CColor + CHelpColor;
CNewBlackWhite = CBlackWhite + CHelpBlackWhite;
CNewMonochrome = CMonochrome + CHelpMonochrome;
P: array[apColor..apMonochrome] of string[Length(CNewColor)] =
(CNewColor, CNewBlackWhite, CNewMonochrome);
begin
GetPalette := @P[AppPalette];
end;
Procedure MyApp.InitMenuBar;
Var
R: TRect;
Begin
GetExtent(R);
R.B.Y := R.A.Y + 1;
MenuBar := New(PMenuBar, Init(R, NewMenu(
NewSubMenu('~F~ile', hcNoContext, NewMenu(
NewItem('~N~ew', 'F4', kbF4, cmNewWin, hcNoContext,
NewItem('~S~ize/Move', 'Ctrl-F5', kbCtrlF5, cmResize, 1051,
nil))),
{------------------------ Macros Modification ----------------------------}
{ Add code below to your application's menu. }
{-------------------------------------------------------------------------}
{$IFDEF MACROS}
NewSubMenu('~M~acros', {0}hcMacros, NewMenu(
NewItem('~R~ecord', '', kbNoKey, cmRecordMacro, hcRecording,
NewItem('~S~top Recording', '', kbNoKey, cmStopRecording, hcRecording,
NewItem('~D~elete', '', kbNoKey, cmDeleteMacro, hcDeleting,
NewItem('~P~layback', '', kbNoKey, cmPlaybackMacro, hcPlayback,
nil))))),
{$ENDIF}
NewLine(
NewItem('E~x~it', 'Alt-X', kbAltX, cmQuit, hcNoContext,
nil))))))
{$IFDEF MACROS}
)
{$ENDIF}
;
End;
{$IFDEF MACROS}
procedure MyApp.GetEvent(var Event: TEvent);
var
WH: PWindow;
HFile: PHelpFile;
HelpStrm: PDosStream;
const
HelpInUse: Boolean = False;
begin
{------------------------ Macros Modification ----------------------------}
{ Calls TMacApp.GetEvent instead of TApplication.GetEvent. }
{ This change is required only if your application overrides GetEvent to }
{ implement context-sensitive help (as done in TVDEMO.PAS). }
{-------------------------------------------------------------------------}
TMacApp.GetEvent(Event);
{TApplication.GetEvent(Event);}
case Event.What of
evCommand:
if (Event.Command = cmHelp) and not HelpInUse then
begin
HelpInUse := True;
{------------------------ Macros Modification ----------------------------}
{ The name of the Macros Help file is here, instead of your help file, in }
{ order to supply help for this demo. }
{-------------------------------------------------------------------------}
HelpStrm := New(PDosStream, Init('MACHELP.HLP', stOpenRead));
HFile := New(PHelpFile, Init(HelpStrm));
if HelpStrm^.Status <> stOk then
begin
MessageBox('Could not open help file.', nil, mfError + mfOkButton);
Dispose(HFile, Done);
end
else
begin
WH := New(PHelpWindow,Init(HFile, GetHelpCtx));
if ValidView(WH) <> nil then
begin
ExecView(WH);
Dispose(WH, Done);
end;
ClearEvent(Event);
end;
HelpInUse := False;
end;
evMouseDown:
if Event.Buttons <> 1 then Event.What := evNothing;
end;
end;
{$ENDIF}
Procedure MyApp.InitStatusLine;
Var
R: TRect;
Begin
GetExtent(R);
R.A.Y := R.B.Y - 1;
StatusLine := New(PMyStatusLine, Init(R,
NewStatusDef(0, $FFFF,
NewStatusKey('~F1~ Help', kbF1, cmHelp,
NewStatusKey('', kbF10, cmMenu,
NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
NewStatusKey('~F4~ New', kbF4, cmNewWin,
NewStatusKey('~Alt-F3~ Close', kbAltF3, cmClose,
nil))))),
nil)));
End;
Procedure MyApp.HandleEvent(var Event: TEvent);
Begin
TApplication.HandleEvent(Event);
if Event.What = evCommand then
Begin
Case Event.Command of
cmNewWin: NewWindow;
{------------------------ Macros Modification ----------------------------}
{ Add code block below to your application's event handler. }
{-------------------------------------------------------------------------}
{$IFDEF MACROS}
cmRecordMacro : StartRecording;
cmStopRecording : begin
StopRecording;
ClearEvent (Event); { ********************* }
PutEvent (Event); { Clears event queue. }
{ Required for macros }
{ that playback other }
{ macros. }
end;
cmPlaybackMacro : StartPlayback;
cmDeleteMacro : DeleteMacro;
{$ENDIF}
else
Exit;
End;
ClearEvent(Event);
End;
End;
Procedure MyApp.NewWindow;
Var
Window:PMyWindow;
R: TRect;
Begin
R.Assign(0, 0, 24, 7);
R.Move(Random(55), Random(16));
Window := New(PMyWindow, Init(R, 'Demo Window', 1));
DeskTop^.Insert(Window);
End;
{ ** MyDeskTop **}
{ ** MyWindow **}
Constructor TMyWindow.Init(Bounds: TRect; WinTitle: String; WindowNo: Word);
Begin
TWindow.init(Bounds,WinTitle,WindowNo);
End;
{ Main Program }
Var
MyTApp:MyApp;
Begin
MyTApp.Init;
MyTApp.Run;
MyTApp.Done;
End.